home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / ExtUtils / MM_VMS.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  65.7 KB  |  2,235 lines
  1.  
  2. package ExtUtils::MM_VMS;
  3.  
  4. use Carp qw( &carp );
  5. use Config;
  6. require Exporter;
  7. use VMS::Filespec;
  8. use File::Basename;
  9.  
  10. use vars qw($Revision);
  11. $Revision = '5.3901 (6-Mar-1997)';
  12.  
  13. unshift @MM::ISA, 'ExtUtils::MM_VMS';
  14.  
  15. Exporter::import('ExtUtils::MakeMaker', '$Verbose', '&neatvalue');
  16.  
  17. =head1 NAME
  18.  
  19. ExtUtils::MM_VMS - methods to override UN*X behaviour in ExtUtils::MakeMaker
  20.  
  21. =head1 SYNOPSIS
  22.  
  23.  use ExtUtils::MM_VMS; # Done internally by ExtUtils::MakeMaker if needed
  24.  
  25. =head1 DESCRIPTION
  26.  
  27. See ExtUtils::MM_Unix for a documentation of the methods provided
  28. there. This package overrides the implementation of these methods, not
  29. the semantics.
  30.  
  31. =head2 Methods always loaded
  32.  
  33. =over
  34.  
  35. =item eliminate_macros
  36.  
  37. Expands MM[KS]/Make macros in a text string, using the contents of
  38. identically named elements of C<%$self>, and returns the result
  39. as a file specification in Unix syntax.
  40.  
  41. =cut
  42.  
  43. sub eliminate_macros {
  44.     my($self,$path) = @_;
  45.     unless ($path) {
  46.     print "eliminate_macros('') = ||\n" if $Verbose >= 3;
  47.     return '';
  48.     }
  49.     my($npath) = unixify($path);
  50.     my($complex) = 0;
  51.     my($head,$macro,$tail);
  52.  
  53.     while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#g) { 
  54.         if ($self->{$2}) {
  55.             ($head,$macro,$tail) = ($1,$2,$3);
  56.             if (ref $self->{$macro}) {
  57.               carp "Can't expand macro containing " . ref $self->{$macro};
  58.               $npath = "$head\cB$macro\cB$tail";
  59.               $complex = 1;
  60.             }
  61.             else { ($macro = unixify($self->{$macro})) =~ s#/$##; }
  62.             $npath = "$head$macro$tail";
  63.         }
  64.     }
  65.     if ($complex) { $npath =~ s#\cB(.*?)\cB#\$($1)#g; }
  66.     print "eliminate_macros($path) = |$npath|\n" if $Verbose >= 3;
  67.     $npath;
  68. }
  69.  
  70. =item fixpath
  71.  
  72. Catchall routine to clean up problem MM[SK]/Make macros.  Expands macros
  73. in any directory specification, in order to avoid juxtaposing two
  74. VMS-syntax directories when MM[SK] is run.  Also expands expressions which
  75. are all macro, so that we can tell how long the expansion is, and avoid
  76. overrunning DCL's command buffer when MM[KS] is running.
  77.  
  78. If optional second argument has a TRUE value, then the return string is
  79. a VMS-syntax directory specification, otherwise it is a VMS-syntax file
  80. specification.
  81.  
  82. =cut
  83.  
  84. sub fixpath {
  85.     my($self,$path,$force_path) = @_;
  86.     unless ($path) {
  87.     print "eliminate_macros('') = ||\n" if $Verbose >= 3;
  88.     return '';
  89.     }
  90.     my($fixedpath,$prefix,$name);
  91.  
  92.     if ($path =~ m#^\$\([^\)]+\)$# || $path =~ m#[/:>\]]#) { 
  93.         if ($force_path or $path =~ /(?:DIR\)|\])$/) {
  94.             $fixedpath = vmspath($self->eliminate_macros($path));
  95.         }
  96.         else {
  97.             $fixedpath = vmsify($self->eliminate_macros($path));
  98.         }
  99.     }
  100.     elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#)) && $self->{$prefix}) {
  101.         my($vmspre) = $self->eliminate_macros("\$($prefix)");
  102.         $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR$/) ? vmspath($vmspre) : '';
  103.         $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
  104.         $fixedpath = vmspath($fixedpath) if $force_path;
  105.     }
  106.     else {
  107.         $fixedpath = $path;
  108.         $fixedpath = vmspath($fixedpath) if $force_path;
  109.     }
  110.     if (!$force_path and $fixedpath !~ /[:>(.\]]/) { $fixedpath = vmspath($fixedpath); }
  111.     $fixedpath =~ s/\.000000([\]>])/$1/;
  112.     print "fixpath($path) = |$fixedpath|\n" if $Verbose >= 3;
  113.     $fixedpath;
  114. }
  115.  
  116. =item catdir
  117.  
  118. Concatenates a list of file specifications, and returns the result as a
  119. VMS-syntax directory specification.
  120.  
  121. =cut
  122.  
  123. sub catdir {
  124.     my($self,@dirs) = @_;
  125.     my($dir) = pop @dirs;
  126.     @dirs = grep($_,@dirs);
  127.     my($rslt);
  128.     if (@dirs) {
  129.       my($path) = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
  130.       my($spath,$sdir) = ($path,$dir);
  131.       $spath =~ s/.dir$//; $sdir =~ s/.dir$//; 
  132.       $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/;
  133.       $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
  134.     }
  135.     else { 
  136.       if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; }
  137.       else                          { $rslt = vmspath($dir); }
  138.     }
  139.     print "catdir(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
  140.     $rslt;
  141. }
  142.  
  143. =item catfile
  144.  
  145. Concatenates a list of file specifications, and returns the result as a
  146. VMS-syntax directory specification.
  147.  
  148. =cut
  149.  
  150. sub catfile {
  151.     my($self,@files) = @_;
  152.     my($file) = pop @files;
  153.     @files = grep($_,@files);
  154.     my($rslt);
  155.     if (@files) {
  156.       my($path) = (@files == 1 ? $files[0] : $self->catdir(@files));
  157.       my($spath) = $path;
  158.       $spath =~ s/.dir$//;
  159.       if ( $spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) { $rslt = "$spath$file"; }
  160.       else {
  161.           $rslt = $self->eliminate_macros($spath);
  162.           $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file));
  163.       }
  164.     }
  165.     else { $rslt = vmsify($file); }
  166.     print "catfile(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
  167.     $rslt;
  168. }
  169.  
  170. =item wraplist
  171.  
  172. Converts a list into a string wrapped at approximately 80 columns.
  173.  
  174. =cut
  175.  
  176. sub wraplist {
  177.     my($self) = shift;
  178.     my($line,$hlen) = ('',0);
  179.     my($word);
  180.  
  181.     foreach $word (@_) {
  182.       next unless $word =~ /\w/;
  183.       $line .= ', ' if length($line);
  184.       if ($hlen > 80) { $line .= "\\\n\t"; $hlen = 0; }
  185.       $line .= $word;
  186.       $hlen += length($word) + 2;
  187.     }
  188.     $line;
  189. }
  190.  
  191. =item curdir (override)
  192.  
  193. Returns a string representing of the current directory.
  194.  
  195. =cut
  196.  
  197. sub curdir {
  198.     return '[]';
  199. }
  200.  
  201. =item rootdir (override)
  202.  
  203. Returns a string representing of the root directory.
  204.  
  205. =cut
  206.  
  207. sub rootdir {
  208.     return '';
  209. }
  210.  
  211. =item updir (override)
  212.  
  213. Returns a string representing of the parent directory.
  214.  
  215. =cut
  216.  
  217. sub updir {
  218.     return '[-]';
  219. }
  220.  
  221. package ExtUtils::MM_VMS;
  222.  
  223. sub ExtUtils::MM_VMS::ext;
  224. sub ExtUtils::MM_VMS::guess_name;
  225. sub ExtUtils::MM_VMS::find_perl;
  226. sub ExtUtils::MM_VMS::path;
  227. sub ExtUtils::MM_VMS::maybe_command;
  228. sub ExtUtils::MM_VMS::maybe_command_in_dirs;
  229. sub ExtUtils::MM_VMS::perl_script;
  230. sub ExtUtils::MM_VMS::file_name_is_absolute;
  231. sub ExtUtils::MM_VMS::replace_manpage_separator;
  232. sub ExtUtils::MM_VMS::init_others;
  233. sub ExtUtils::MM_VMS::constants;
  234. sub ExtUtils::MM_VMS::cflags;
  235. sub ExtUtils::MM_VMS::const_cccmd;
  236. sub ExtUtils::MM_VMS::pm_to_blib;
  237. sub ExtUtils::MM_VMS::tool_autosplit;
  238. sub ExtUtils::MM_VMS::tool_xsubpp;
  239. sub ExtUtils::MM_VMS::xsubpp_version;
  240. sub ExtUtils::MM_VMS::tools_other;
  241. sub ExtUtils::MM_VMS::dist;
  242. sub ExtUtils::MM_VMS::c_o;
  243. sub ExtUtils::MM_VMS::xs_c;
  244. sub ExtUtils::MM_VMS::xs_o;
  245. sub ExtUtils::MM_VMS::top_targets;
  246. sub ExtUtils::MM_VMS::dlsyms;
  247. sub ExtUtils::MM_VMS::dynamic_lib;
  248. sub ExtUtils::MM_VMS::dynamic_bs;
  249. sub ExtUtils::MM_VMS::static_lib;
  250. sub ExtUtils::MM_VMS::manifypods;
  251. sub ExtUtils::MM_VMS::processPL;
  252. sub ExtUtils::MM_VMS::installbin;
  253. sub ExtUtils::MM_VMS::subdir_x;
  254. sub ExtUtils::MM_VMS::clean;
  255. sub ExtUtils::MM_VMS::realclean;
  256. sub ExtUtils::MM_VMS::dist_basics;
  257. sub ExtUtils::MM_VMS::dist_core;
  258. sub ExtUtils::MM_VMS::dist_dir;
  259. sub ExtUtils::MM_VMS::dist_test;
  260. sub ExtUtils::MM_VMS::install;
  261. sub ExtUtils::MM_VMS::perldepend;
  262. sub ExtUtils::MM_VMS::makefile;
  263. sub ExtUtils::MM_VMS::test;
  264. sub ExtUtils::MM_VMS::test_via_harness;
  265. sub ExtUtils::MM_VMS::test_via_script;
  266. sub ExtUtils::MM_VMS::makeaperl;
  267. sub ExtUtils::MM_VMS::ext;
  268. sub ExtUtils::MM_VMS::nicetext;
  269.  
  270. sub AUTOLOAD {
  271.     my $code;
  272.     if (defined fileno(DATA)) {
  273.     my $fh = select DATA;
  274.     my $o = $/;            # For future reads from the file.
  275.     $/ = "\n__END__\n";
  276.     $code = <DATA>;
  277.     $/ = $o;
  278.     select $fh;
  279.     close DATA;
  280.     eval $code;
  281.     if ($@) {
  282.         $@ =~ s/ at .*\n//;
  283.         Carp::croak $@;
  284.     }
  285.     } else {
  286.     warn "AUTOLOAD called unexpectedly for $AUTOLOAD"; 
  287.     }
  288.     defined(&$AUTOLOAD) or die "Myloader inconsistency error";
  289.     goto &$AUTOLOAD;
  290. }
  291.  
  292. 1;
  293.  
  294.  
  295.  
  296. sub ext {
  297.   ExtUtils::Liblist::ext(@_);
  298. }
  299.  
  300. =back
  301.  
  302. =head2 SelfLoaded methods
  303.  
  304. Those methods which override default MM_Unix methods are marked
  305. "(override)", while methods unique to MM_VMS are marked "(specific)".
  306. For overridden methods, documentation is limited to an explanation
  307. of why this method overrides the MM_Unix method; see the ExtUtils::MM_Unix
  308. documentation for more details.
  309.  
  310. =over
  311.  
  312. =item guess_name (override)
  313.  
  314. Try to determine name of extension being built.  We begin with the name
  315. of the current directory.  Since VMS filenames are case-insensitive,
  316. however, we look for a F<.pm> file whose name matches that of the current
  317. directory (presumably the 'main' F<.pm> file for this extension), and try
  318. to find a C<package> statement from which to obtain the Mixed::Case
  319. package name.
  320.  
  321. =cut
  322.  
  323. sub guess_name {
  324.     my($self) = @_;
  325.     my($defname,$defpm,@pm,%xs,$pm);
  326.     local *PM;
  327.  
  328.     $defname = basename(fileify($ENV{'DEFAULT'}));
  329.     $defname =~ s![\d\-_]*\.dir.*$!!;  # Clip off .dir;1 suffix, and package version
  330.     $defpm = $defname;
  331.     if (not -e "${defpm}.pm") {
  332.       @pm = map { s/.pm$//; $_ } glob('*.pm');
  333.       if (@pm == 1) { ($defpm = $pm[0]) =~ s/.pm$//; }
  334.       elsif (@pm) {
  335.         %xs = map { s/.xs$//; ($_,1) } glob('*.xs');
  336.         if (%xs) { foreach $pm (@pm) { $defpm = $pm, last if exists $xs{$pm}; } }
  337.       }
  338.     }
  339.     if (open(PM,"${defpm}.pm")){
  340.         while (<PM>) {
  341.             if (/^\s*package\s+([^;]+)/i) {
  342.                 $defname = $1;
  343.                 last;
  344.             }
  345.         }
  346.         print STDOUT "Warning (non-fatal): Couldn't find package name in ${defpm}.pm;\n\t",
  347.                      "defaulting package name to $defname\n"
  348.             if eof(PM);
  349.         close PM;
  350.     }
  351.     else {
  352.         print STDOUT "Warning (non-fatal): Couldn't find ${defpm}.pm;\n\t",
  353.                      "defaulting package name to $defname\n";
  354.     }
  355.     $defname =~ s#[\d.\-_]+$##;
  356.     $defname;
  357. }
  358.  
  359. =item find_perl (override)
  360.  
  361. Use VMS file specification syntax and CLI commands to find and
  362. invoke Perl images.
  363.  
  364. =cut
  365.  
  366. sub find_perl {
  367.     my($self, $ver, $names, $dirs, $trace) = @_;
  368.     my($name,$dir,$vmsfile,@sdirs,@snames,@cand);
  369.     my($inabs) = 0;
  370.     @sdirs = sort { my($absa) = $self->file_name_is_absolute($a);
  371.                     my($absb) = $self->file_name_is_absolute($b);
  372.                     if ($absa && $absb) { return $a cmp $b }
  373.                     else { return $absa ? 1 : ($absb ? -1 : ($a cmp $b)); }
  374.                   } @$dirs;
  375.     @snames = sort { my($ba) = $a =~ m!([^:>\]/]+)$!;  # basename
  376.                      my($bb) = $b =~ m!([^:>\]/]+)$!;
  377.                      my($ahasdir) = (length($a) - length($ba) > 0);
  378.                      my($bhasdir) = (length($b) - length($bb) > 0);
  379.                      if    ($ahasdir and not $bhasdir) { return 1; }
  380.                      elsif ($bhasdir and not $ahasdir) { return -1; }
  381.                      else { $bb =~ /\d/ <=> $ba =~ /\d/
  382.                             or substr($ba,0,1) cmp substr($bb,0,1)
  383.                             or length($bb) <=> length($ba) } } @$names;
  384.     foreach $name (@snames) { $name =~ s/\.(\d+)$/_$1/; }
  385.     if ($trace >= 2){
  386.     print "Looking for perl $ver by these names:\n";
  387.     print "\t@snames,\n";
  388.     print "in these dirs:\n";
  389.     print "\t@sdirs\n";
  390.     }
  391.     foreach $dir (@sdirs){
  392.     next unless defined $dir; # $self->{PERL_SRC} may be undefined
  393.     $inabs++ if $self->file_name_is_absolute($dir);
  394.     if ($inabs == 1) {
  395.         foreach $name (@snames) { push(@cand,$name) if $name =~ /^[\w\-\$]+$/; }
  396.         $inabs++; # Should happen above in next $dir, but just in case . . .
  397.     }
  398.     foreach $name (@snames){
  399.         if ($name !~ m![/:>\]]!) { push(@cand,$self->catfile($dir,$name)); }
  400.         else                     { push(@cand,$self->fixpath($name));      }
  401.     }
  402.     }
  403.     foreach $name (@cand) {
  404.     print "Checking $name\n" if ($trace >= 2);
  405.     if ($name =~ /^[\w\-\$]+$/ &&
  406.         `$name -e "require $ver; print ""VER_OK\n"""` =~ /VER_OK/) {
  407.         print "Using PERL=$name\n" if $trace;
  408.         return $name;
  409.     }
  410.     next unless $vmsfile = $self->maybe_command($name);
  411.     $vmsfile =~ s/;[\d\-]*$//;  # Clip off version number; we can use a newer version as well
  412.     print "Executing $vmsfile\n" if ($trace >= 2);
  413.     if (`MCR $vmsfile -e "require $ver; print ""VER_OK\n"""` =~ /VER_OK/) {
  414.         print "Using PERL=MCR $vmsfile\n" if $trace;
  415.         return "MCR $vmsfile";
  416.     }
  417.     }
  418.     print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
  419.     0; # false and not empty
  420. }
  421.  
  422. =item path (override)
  423.  
  424. Translate logical name DCL$PATH as a searchlist, rather than trying
  425. to C<split> string value of C<$ENV{'PATH'}>.
  426.  
  427. =cut
  428.  
  429. sub path {
  430.     my(@dirs,$dir,$i);
  431.     while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); }
  432.     @dirs;
  433. }
  434.  
  435. =item maybe_command (override)
  436.  
  437. Follows VMS naming conventions for executable files.
  438. If the name passed in doesn't exactly match an executable file,
  439. appends F<.Exe> (or equivalent) to check for executable image, and F<.Com>
  440. to check for DCL procedure.  If this fails, checks directories in DCL$PATH
  441. and finally F<Sys$System:> for an executable file having the name specified,
  442. with or without the F<.Exe>-equivalent suffix.
  443.  
  444. =cut
  445.  
  446. sub maybe_command {
  447.     my($self,$file) = @_;
  448.     return $file if -x $file && ! -d _;
  449.     my(@dirs) = ('');
  450.     my(@exts) = ('',$Config{'exe_ext'},'.exe','.com');
  451.     my($dir,$ext);
  452.     if ($file !~ m![/:>\]]!) {
  453.     for (my $i = 0; defined $ENV{"DCL\$PATH;$i"}; $i++) {
  454.         $dir = $ENV{"DCL\$PATH;$i"};
  455.         $dir .= ':' unless $dir =~ m%[\]:]$%;
  456.         push(@dirs,$dir);
  457.     }
  458.     push(@dirs,'Sys$System:');
  459.     foreach $dir (@dirs) {
  460.         my $sysfile = "$dir$file";
  461.         foreach $ext (@exts) {
  462.         return $file if -x "$sysfile$ext" && ! -d _;
  463.         }
  464.     }
  465.     }
  466.     return 0;
  467. }
  468.  
  469. =item maybe_command_in_dirs (override)
  470.  
  471. Uses DCL argument quoting on test command line.
  472.  
  473. =cut
  474.  
  475. sub maybe_command_in_dirs {    # $ver is optional argument if looking for perl
  476.     my($self, $names, $dirs, $trace, $ver) = @_;
  477.     my($name, $dir);
  478.     foreach $dir (@$dirs){
  479.     next unless defined $dir; # $self->{PERL_SRC} may be undefined
  480.     foreach $name (@$names){
  481.         my($abs,$tryabs);
  482.         if ($self->file_name_is_absolute($name)) {
  483.         $abs = $name;
  484.         } else {
  485.         $abs = $self->catfile($dir, $name);
  486.         }
  487.         print "Checking $abs for $name\n" if ($trace >= 2);
  488.         next unless $tryabs = $self->maybe_command($abs);
  489.         print "Substituting $tryabs instead of $abs\n" 
  490.         if ($trace >= 2 and $tryabs ne $abs);
  491.         $abs = $tryabs;
  492.         if (defined $ver) {
  493.         print "Executing $abs\n" if ($trace >= 2);
  494.         if (`$abs -e 'require $ver; print "VER_OK\n" ' 2>&1` =~ /VER_OK/) {
  495.             print "Using $abs\n" if $trace;
  496.             return $abs;
  497.         }
  498.         } else { # Do not look for perl
  499.         return $abs;
  500.         }
  501.     }
  502.     }
  503. }
  504.  
  505. =item perl_script (override)
  506.  
  507. If name passed in doesn't specify a readable file, appends F<.com> or
  508. F<.pl> and tries again, since it's customary to have file types on all files
  509. under VMS.
  510.  
  511. =cut
  512.  
  513. sub perl_script {
  514.     my($self,$file) = @_;
  515.     return $file if -r $file && ! -d _;
  516.     return "$file.com" if -r "$file.com";
  517.     return "$file.pl" if -r "$file.pl";
  518.     return '';
  519. }
  520.  
  521. =item file_name_is_absolute (override)
  522.  
  523. Checks for VMS directory spec as well as Unix separators.
  524.  
  525. =cut
  526.  
  527. sub file_name_is_absolute {
  528.     my($self,$file) = @_;
  529.     $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ and $ENV{$file};
  530.     $file =~ m!^/! or $file =~ m![<\[][^.\-\]>]! or $file =~ /:[^<\[]/;
  531. }
  532.  
  533. =item replace_manpage_separator
  534.  
  535. Use as separator a character which is legal in a VMS-syntax file name.
  536.  
  537. =cut
  538.  
  539. sub replace_manpage_separator {
  540.     my($self,$man) = @_;
  541.     $man = unixify($man);
  542.     $man =~ s#/+#__#g;
  543.     $man;
  544. }
  545.  
  546. =item init_others (override)
  547.  
  548. Provide VMS-specific forms of various utility commands, then hand
  549. off to the default MM_Unix method.
  550.  
  551. =cut
  552.  
  553. sub init_others {
  554.     my($self) = @_;
  555.  
  556.     $self->{NOOP} = 'Continue';
  557.     $self->{FIRST_MAKEFILE} ||= 'Descrip.MMS';
  558.     $self->{MAKE_APERL_FILE} ||= 'Makeaperl.MMS';
  559.     $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE};
  560.     $self->{NOECHO} ||= '@ ';
  561.     $self->{RM_F} = '$(PERL) -e "foreach (@ARGV) { 1 while ( -d $_ ? rmdir $_ : unlink $_)}"';
  562.     $self->{RM_RF} = '$(PERL) "-I$(PERL_LIB)" -e "use File::Path; @dirs = map(VMS::Filespec::unixify($_),@ARGV); rmtree(\@dirs,0,0)"';
  563.     $self->{TOUCH} = '$(PERL) -e "$t=time; foreach (@ARGV) { -e $_ ? utime($t,$t,@ARGV) : (open(F,qq(>$_)),close F)}"';
  564.     $self->{CHMOD} = '$(PERL) -e "chmod @ARGV"';  # expect Unix syntax from MakeMaker
  565.     $self->{CP} = 'Copy/NoConfirm';
  566.     $self->{MV} = 'Rename/NoConfirm';
  567.     $self->{UMASK_NULL} = '! ';  
  568.     &ExtUtils::MM_Unix::init_others;
  569. }
  570.  
  571. =item constants (override)
  572.  
  573. Fixes up numerous file and directory macros to insure VMS syntax
  574. regardless of input syntax.  Also adds a few VMS-specific macros
  575. and makes lists of files comma-separated.
  576.  
  577. =cut
  578.  
  579. sub constants {
  580.     my($self) = @_;
  581.     my(@m,$def,$macro);
  582.  
  583.     if ($self->{DEFINE} ne '') {
  584.     my(@defs) = split(/\s+/,$self->{DEFINE});
  585.     foreach $def (@defs) {
  586.         next unless $def;
  587.         if ($def =~ s/^-D//) {       # If it was a Unix-style definition
  588.         $def =~ s/='(.*)'$/=$1/;  # then remove shell-protection ''
  589.         $def =~ s/^'(.*)'$/$1/;   # from entire term or argument
  590.         }
  591.         if ($def =~ /=/) {
  592.         $def =~ s/"/""/g;  # Protect existing " from DCL
  593.         $def = qq["$def"]; # and quote to prevent parsing of =
  594.         }
  595.     }
  596.     $self->{DEFINE} = join ',',@defs;
  597.     }
  598.  
  599.     if ($self->{OBJECT} =~ /\s/) {
  600.     $self->{OBJECT} =~ s/(\\)?\n+\s+/ /g;
  601.     $self->{OBJECT} = join(' ',map($self->fixpath($_),split(/,?\s+/,$self->{OBJECT})));
  602.     }
  603.     $self->{LDFROM} = join(' ',map($self->fixpath($_),split(/,?\s+/,$self->{LDFROM})));
  604.  
  605.  
  606.     $self->{ROOTEXT} = $self->{ROOTEXT} ? $self->fixpath($self->{ROOTEXT},1)
  607.                                         : '[]';
  608.     foreach $macro ( qw [
  609.             INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB INST_EXE INSTALLPRIVLIB
  610.             INSTALLARCHLIB INSTALLSCRIPT INSTALLBIN PERL_LIB PERL_ARCHLIB
  611.             PERL_INC PERL_SRC FULLEXT INST_MAN1DIR INSTALLMAN1DIR
  612.             INST_MAN3DIR INSTALLMAN3DIR INSTALLSITELIB INSTALLSITEARCH
  613.             SITELIBEXP SITEARCHEXP ] ) {
  614.     next unless defined $self->{$macro};
  615.     $self->{$macro} = $self->fixpath($self->{$macro},1);
  616.     }
  617.     $self->{PERL_VMS} = $self->catdir($self->{PERL_SRC},q(VMS))
  618.     if ($self->{PERL_SRC});
  619.                         
  620.  
  621.  
  622.     foreach $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKE_APERL_FILE MYEXTLIB] ) {
  623.     next unless defined $self->{$macro};
  624.     $self->{$macro} = $self->fixpath($self->{$macro});
  625.     }
  626.  
  627.     foreach $macro (qw/
  628.           AR_STATIC_ARGS NAME DISTNAME NAME_SYM VERSION VERSION_SYM XS_VERSION
  629.           INST_BIN INST_EXE INST_LIB INST_ARCHLIB INST_SCRIPT PREFIX
  630.           INSTALLDIRS INSTALLPRIVLIB  INSTALLARCHLIB INSTALLSITELIB
  631.           INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB
  632.           PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB
  633.           FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC PERL_VMS
  634.           PERL_INC PERL FULLPERL
  635.           / ) {
  636.     next unless defined $self->{$macro};
  637.     push @m, "$macro = $self->{$macro}\n";
  638.     }
  639.  
  640.  
  641.     push @m, q[
  642. VERSION_MACRO = VERSION
  643. DEFINE_VERSION = "$(VERSION_MACRO)=""$(VERSION)"""
  644. XS_VERSION_MACRO = XS_VERSION
  645. XS_DEFINE_VERSION = "$(XS_VERSION_MACRO)=""$(XS_VERSION)"""
  646.  
  647. MAKEMAKER = ],$self->catfile($self->{PERL_LIB},'ExtUtils','MakeMaker.pm'),qq[
  648. MM_VERSION = $ExtUtils::MakeMaker::VERSION
  649. MM_REVISION = $ExtUtils::MakeMaker::Revision
  650. MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision
  651.  
  652. ];
  653.  
  654.     for $tmp (qw/
  655.           FULLEXT VERSION_FROM OBJECT LDFROM
  656.           /    ) {
  657.     next unless defined $self->{$tmp};
  658.     push @m, "$tmp = ",$self->fixpath($self->{$tmp}),"\n";
  659.     }
  660.  
  661.     for $tmp (qw/
  662.           BASEEXT PARENT_NAME DLBASE INC DEFINE LINKTYPE
  663.           /    ) {
  664.     next unless defined $self->{$tmp};
  665.     push @m, "$tmp = $self->{$tmp}\n";
  666.     }
  667.  
  668.     for $tmp (qw/ XS MAN1PODS MAN3PODS PM /) {
  669.     next unless defined $self->{$tmp};
  670.     my(%tmp,$key);
  671.     for $key (keys %{$self->{$tmp}}) {
  672.         $tmp{$self->fixpath($key)} = $self->fixpath($self->{$tmp}{$key});
  673.     }
  674.     $self->{$tmp} = \%tmp;
  675.     }
  676.  
  677.     for $tmp (qw/ C O_FILES H /) {
  678.     next unless defined $self->{$tmp};
  679.     my(@tmp,$val);
  680.     for $val (@{$self->{$tmp}}) {
  681.         push(@tmp,$self->fixpath($val));
  682.     }
  683.     $self->{$tmp} = \@tmp;
  684.     }
  685.  
  686.     push @m,'
  687.  
  688. XS_FILES = ',$self->wraplist(', ', sort keys %{$self->{XS}}),'
  689. C_FILES  = ',$self->wraplist(', ', @{$self->{C}}),'
  690. O_FILES  = ',$self->wraplist(', ', @{$self->{O_FILES}} ),'
  691. H_FILES  = ',$self->wraplist(', ', @{$self->{H}}),'
  692. MAN1PODS = ',$self->wraplist(', ', sort keys %{$self->{MAN1PODS}}),'
  693. MAN3PODS = ',$self->wraplist(', ', sort keys %{$self->{MAN3PODS}}),'
  694.  
  695. ';
  696.  
  697.     for $tmp (qw/
  698.           INST_MAN1DIR INSTALLMAN1DIR MAN1EXT INST_MAN3DIR INSTALLMAN3DIR MAN3EXT
  699.           /) {
  700.     next unless defined $self->{$tmp};
  701.     push @m, "$tmp = $self->{$tmp}\n";
  702.     }
  703.  
  704. push @m,"
  705. .SUFFIXES :
  706. .SUFFIXES : \$(OBJ_EXT) .c .cpp .cxx .xs
  707.  
  708. CONFIGDEP = \$(PERL_ARCHLIB)Config.pm, \$(PERL_INC)config.h \$(VERSION_FROM)
  709.  
  710. INST_LIBDIR      = $self->{INST_LIBDIR}
  711. INST_ARCHLIBDIR  = $self->{INST_ARCHLIBDIR}
  712.  
  713. INST_AUTODIR     = $self->{INST_AUTODIR}
  714. INST_ARCHAUTODIR = $self->{INST_ARCHAUTODIR}
  715. ";
  716.  
  717.     if ($self->has_link_code()) {
  718.     push @m,'
  719. INST_STATIC = $(INST_ARCHAUTODIR)$(BASEEXT)$(LIB_EXT)
  720. INST_DYNAMIC = $(INST_ARCHAUTODIR)$(BASEEXT).$(DLEXT)
  721. INST_BOOT = $(INST_ARCHAUTODIR)$(BASEEXT).bs
  722. ';
  723.     } else {
  724.     push @m,'
  725. INST_STATIC =
  726. INST_DYNAMIC =
  727. INST_BOOT =
  728. EXPORT_LIST = $(BASEEXT).opt
  729. PERL_ARCHIVE = ',($ENV{'PERLSHR'} ? $ENV{'PERLSHR'} : "Sys\$Share:PerlShr.$Config{'dlext'}"),'
  730. ';
  731.     }
  732.  
  733.     $self->{TO_INST_PM} = [ sort keys %{$self->{PM}} ];
  734.     $self->{PM_TO_BLIB} = [ %{$self->{PM}} ];
  735.     push @m,'
  736. TO_INST_PM = ',$self->wraplist(', ',@{$self->{TO_INST_PM}}),'
  737.  
  738. PM_TO_BLIB = ',$self->wraplist(', ',@{$self->{PM_TO_BLIB}}),'
  739. ';
  740.  
  741.     join('',@m);
  742. }
  743.  
  744. =item cflags (override)
  745.  
  746. Bypass shell script and produce qualifiers for CC directly (but warn
  747. user if a shell script for this extension exists).  Fold multiple
  748. /Defines into one, since some C compilers pay attention to only one
  749. instance of this qualifier on the command line.
  750.  
  751. =cut
  752.  
  753. sub cflags {
  754.     my($self,$libperl) = @_;
  755.     my($quals) = $Config{'ccflags'};
  756.     my($name,$sys,@m);
  757.     my($optimize) = '/Optimize';
  758.  
  759.     ( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ;
  760.     print STDOUT "Unix shell script ".$Config{"$self->{'BASEEXT'}_cflags"}.
  761.          " required to modify CC command for $self->{'BASEEXT'}\n"
  762.     if ($Config{$name});
  763.  
  764.     if ($quals =~ m:(.*)/define=\(?([^\(\/\)\s]+)\)?(.*)?:i) {
  765.     $quals = "$1/Define=($2," . ($self->{DEFINE} ? "$self->{DEFINE}," : '') .
  766.              "\$(DEFINE_VERSION),\$(XS_DEFINE_VERSION))$3";
  767.     }
  768.     else {
  769.     $quals .= '/Define=(' . ($self->{DEFINE} ? "$self->{DEFINE}," : '') .
  770.               '$(DEFINE_VERSION),$(XS_DEFINE_VERSION))';
  771.     }
  772.  
  773.     $libperl or $libperl = $self->{LIBPERL_A} || "libperl.olb";
  774.     if ($libperl =~ /libperl(\w+)\./i) {
  775.         my($type) = uc $1;
  776.         my(%map) = ( 'D'  => 'DEBUGGING', 'E' => 'EMBED', 'M' => 'MULTIPLICITY',
  777.                      'DE' => 'DEBUGGING,EMBED', 'DM' => 'DEBUGGING,MULTIPLICITY',
  778.                      'EM' => 'EMBED,MULTIPLICITY', 'DEM' => 'DEBUGGING,EMBED,MULTIPLICITY' );
  779.         $quals =~ s:/define=\(([^\)]+)\):/Define=($1,$map{$type}):i
  780.     }
  781.  
  782.     my($incstr) = '/Include=($(PERL_INC)';
  783.     if ($self->{'INC'}) {
  784.     my(@includes) = split(/\s+/,$self->{INC});
  785.     foreach (@includes) {
  786.         s/^-I//;
  787.         $incstr .= ', '.$self->fixpath($_,1);
  788.     }
  789.     }
  790.     $quals .= "$incstr)";
  791.  
  792.     $optimize = '/Debug/NoOptimize'
  793.     if ($self->{OPTIMIZE} =~ /-g/ or $self->{OPTIMIZE} =~ m!/Debug!i);
  794.  
  795.     return $self->{CFLAGS} = qq{
  796. CCFLAGS = $quals
  797. OPTIMIZE = $optimize
  798. PERLTYPE =
  799. SPLIT =
  800. LARGE =
  801. };
  802. }
  803.  
  804. =item const_cccmd (override)
  805.  
  806. Adds directives to point C preprocessor to the right place when
  807. handling #include E<lt>sys/foo.hE<gt> directives.  Also constructs CC
  808. command line a bit differently than MM_Unix method.
  809.  
  810. =cut
  811.  
  812. sub const_cccmd {
  813.     my($self,$libperl) = @_;
  814.     my(@m);
  815.  
  816.     return $self->{CONST_CCCMD} if $self->{CONST_CCCMD};
  817.     return '' unless $self->needs_linking();
  818.     if ($Config{'vms_cc_type'} eq 'gcc') {
  819.         push @m,'
  820. .FIRST
  821.     ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS GNU_CC_Include:[VMS]';
  822.     }
  823.     elsif ($Config{'vms_cc_type'} eq 'vaxc') {
  824.         push @m,'
  825. .FIRST
  826.     ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").eqs."" Then Define/NoLog SYS Sys$Library
  827.     ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").nes."" Then Define/NoLog SYS VAXC$Include';
  828.     }
  829.     else {
  830.         push @m,'
  831. .FIRST
  832.     ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").eqs."" Then Define/NoLog SYS ',
  833.         ($Config{'arch'} eq 'VMS_AXP' ? 'Sys$Library' : 'DECC$Library_Include'),'
  834.     ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").nes."" Then Define/NoLog SYS DECC$System_Include';
  835.     }
  836.  
  837.     push(@m, "\n\nCCCMD = $Config{'cc'} \$(CCFLAGS)\$(OPTIMIZE)\n");
  838.  
  839.     $self->{CONST_CCCMD} = join('',@m);
  840. }
  841.  
  842. =item pm_to_blib (override)
  843.  
  844. DCL I<still> accepts a maximum of 255 characters on a command
  845. line, so we write the (potentially) long list of file names
  846. to a temp file, then persuade Perl to read it instead of the
  847. command line to find args.
  848.  
  849. =cut
  850.  
  851. sub pm_to_blib {
  852.     my($self) = @_;
  853.     my($line,$from,$to,@m);
  854.     my($autodir) = $self->catdir('$(INST_LIB)','auto');
  855.     my(@files) = @{$self->{PM_TO_BLIB}};
  856.  
  857.     push @m, q{
  858.  
  859. pm_to_blib : pm_to_blib.ts
  860.     $(NOECHO) $(NOOP)
  861.  
  862. pm_to_blib.ts : $(TO_INST_PM)
  863.     $(NOECHO) $(PERL) -e "print '},shift(@files),q{ },shift(@files),q{'" >.MM_tmp
  864. };
  865.  
  866.     $line = '';  # avoid uninitialized var warning
  867.     while ($from = shift(@files),$to = shift(@files)) {
  868.     $line .= " $from $to";
  869.     if (length($line) > 128) {
  870.         push(@m,"\t\$(NOECHO) \$(PERL) -e \"print '$line'\" >>.MM_tmp\n");
  871.         $line = '';
  872.     }
  873.     }
  874.     push(@m,"\t\$(NOECHO) \$(PERL) -e \"print '$line'\" >>.MM_tmp\n") if $line;
  875.  
  876.     push(@m,q[    $(PERL) "-I$(PERL_LIB)" "-MExtUtils::Install" -e "pm_to_blib({split(' ',<STDIN>)},'].$autodir.q[')" <.MM_tmp]);
  877.     push(@m,qq[
  878.     \$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
  879.     \$(NOECHO) \$(TOUCH) pm_to_blib.ts
  880. ]);
  881.  
  882.     join('',@m);
  883. }
  884.  
  885. =item tool_autosplit (override)
  886.  
  887. Use VMS-style quoting on command line.
  888.  
  889. =cut
  890.  
  891. sub tool_autosplit{
  892.     my($self, %attribs) = @_;
  893.     my($asl) = "";
  894.     $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN};
  895.     q{
  896. AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use AutoSplit;}.$asl.q{ AutoSplit::autosplit($ARGV[0], $ARGV[1], 0, 1, 1) ;"
  897. };
  898. }
  899.  
  900. =item tool_sxubpp (override)
  901.  
  902. Use VMS-style quoting on xsubpp command line.
  903.  
  904. =cut
  905.  
  906. sub tool_xsubpp {
  907.     my($self) = @_;
  908.     return '' unless $self->needs_linking;
  909.     my($xsdir) = $self->catdir($self->{PERL_LIB},'ExtUtils');
  910.     $xsdir = $self->catdir($self->{PERL_SRC},'ext') unless (-f $self->catfile($xsdir,'xsubpp'));
  911.     my(@tmdeps) = '$(XSUBPPDIR)typemap';
  912.     if( $self->{TYPEMAPS} ){
  913.     my $typemap;
  914.     foreach $typemap (@{$self->{TYPEMAPS}}){
  915.         if( ! -f  $typemap ){
  916.             warn "Typemap $typemap not found.\n";
  917.         }
  918.         else{
  919.             push(@tmdeps, $self->fixpath($typemap));
  920.         }
  921.     }
  922.     }
  923.     push(@tmdeps, "typemap") if -f "typemap";
  924.     my(@tmargs) = map("-typemap $_", @tmdeps);
  925.     if( exists $self->{XSOPT} ){
  926.     unshift( @tmargs, $self->{XSOPT} );
  927.     }
  928.  
  929.     my $xsubpp_version = $self->xsubpp_version($self->catfile($xsdir,'xsubpp'));
  930.  
  931.     if ( $xsubpp_version > 1.923 ){
  932.     $self->{XSPROTOARG} = '' unless defined $self->{XSPROTOARG};
  933.     } else {
  934.     if (defined $self->{XSPROTOARG} && $self->{XSPROTOARG} =~ /\-prototypes/) {
  935.         print STDOUT qq{Warning: This extension wants to pass the switch "-prototypes" to xsubpp.
  936.     Your version of xsubpp is $xsubpp_version and cannot handle this.
  937.     Please upgrade to a more recent version of xsubpp.
  938. };
  939.     } else {
  940.         $self->{XSPROTOARG} = "";
  941.     }
  942.     }
  943.  
  944.     "
  945. XSUBPPDIR = $xsdir
  946. XSUBPP = \$(PERL) \"-I\$(PERL_ARCHLIB)\" \"-I\$(PERL_LIB)\" \$(XSUBPPDIR)xsubpp
  947. XSPROTOARG = $self->{XSPROTOARG}
  948. XSUBPPDEPS = @tmdeps
  949. XSUBPPARGS = @tmargs
  950. ";
  951. }
  952.  
  953. =item xsubpp_version (override)
  954.  
  955. Test xsubpp exit status according to VMS rules ($sts & 1 ==E<gt> good)
  956. rather than Unix rules ($sts == 0 ==E<gt> good).
  957.  
  958. =cut
  959.  
  960. sub xsubpp_version
  961. {
  962.     my($self,$xsubpp) = @_;
  963.     my ($version) ;
  964.     return '' unless $self->needs_linking;
  965.  
  966.  
  967.  
  968.     my $command = "$self->{PERL} \"-I$self->{PERL_LIB}\" $xsubpp -v";
  969.     print "Running: $command\n" if $Verbose;
  970.     $version = `$command` ;
  971.     if ($?) {
  972.     use vmsish 'status';
  973.     warn "Running '$command' exits with status $?";
  974.     }
  975.     chop $version ;
  976.  
  977.     return $1 if $version =~ /^xsubpp version (.*)/ ;
  978.  
  979.  
  980.     my $counter = '000';
  981.     my ($file) = 'temp' ;
  982.     $counter++ while -e "$file$counter"; # don't overwrite anything
  983.     $file .= $counter;
  984.  
  985.     local(*F);
  986.     open(F, ">$file") or die "Cannot open file '$file': $!\n" ;
  987.     print F <<EOM ;
  988. MODULE = fred PACKAGE = fred
  989.  
  990. int
  991. fred(a)
  992.     int    a;
  993. EOM
  994.  
  995.     close F ;
  996.  
  997.     $command = "$self->{PERL} $xsubpp $file";
  998.     print "Running: $command\n" if $Verbose;
  999.     my $text = `$command` ;
  1000.     if ($?) {
  1001.     use vmsish 'status';
  1002.     warn "Running '$command' exits with status $?";
  1003.     }
  1004.     unlink $file ;
  1005.  
  1006.     return $1 if $text =~ /automatically by xsubpp version ([\S]+)\s*/  ;
  1007.  
  1008.     return 1.1 if $text =~ /^Warning: ignored semicolon/ ;
  1009.  
  1010.     return "1.0" ;
  1011. }
  1012.  
  1013. =item tools_other (override)
  1014.  
  1015. Adds a few MM[SK] macros, and shortens some the installatin commands,
  1016. in order to stay under DCL's 255-character limit.  Also changes
  1017. EQUALIZE_TIMESTAMP to set revision date of target file to one second
  1018. later than source file, since MMK interprets precisely equal revision
  1019. dates for a source and target file as a sign that the target needs
  1020. to be updated.
  1021.  
  1022. =cut
  1023.  
  1024. sub tools_other {
  1025.     my($self) = @_;
  1026.     qq!
  1027. USEMAKEFILE = /Descrip=
  1028. USEMACROS = /Macro=(
  1029. MACROEND = )
  1030. MAKEFILE = Descrip.MMS
  1031. SHELL = Posix
  1032. TOUCH = $self->{TOUCH}
  1033. CHMOD = $self->{CHMOD}
  1034. CP = $self->{CP}
  1035. MV = $self->{MV}
  1036. RM_F  = $self->{RM_F}
  1037. RM_RF = $self->{RM_RF}
  1038. SAY = Write Sys\$Output
  1039. UMASK_NULL = $self->{UMASK_NULL}
  1040. NOOP = $self->{NOOP}
  1041. NOECHO = $self->{NOECHO}
  1042. MKPATH = Create/Directory
  1043. EQUALIZE_TIMESTAMP = \$(PERL) -we "open F,qq{>\$ARGV[1]};close F;utime(0,(stat(\$ARGV[0]))[9]+1,\$ARGV[1])"
  1044. !. ($self->{PARENT} ? '' : 
  1045. qq!WARN_IF_OLD_PACKLIST = \$(PERL) -e "if (-f \$ARGV[0]){print qq[WARNING: Old package found (\$ARGV[0]); please check for collisions\\n]}"
  1046. MOD_INSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "install({split(' ',<STDIN>)},1);"
  1047. DOC_INSTALL = \$(PERL) -e "\@ARGV=split(/\\|/,<STDIN>);print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];while(\$key=shift && \$val=shift){print qq[=item *\\n\\nC<\$key: \$val>\\n\\n];}print qq[=back\\n\\n]"
  1048. UNINSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "uninstall(\$ARGV[0],1,1);"
  1049. !);
  1050. }
  1051.  
  1052. =item dist (override)
  1053.  
  1054. Provide VMSish defaults for some values, then hand off to
  1055. default MM_Unix method.
  1056.  
  1057. =cut
  1058.  
  1059. sub dist {
  1060.     my($self, %attribs) = @_;
  1061.     $attribs{VERSION}      ||= $self->{VERSION_SYM};
  1062.     $attribs{NAME}         ||= $self->{DISTNAME};
  1063.     $attribs{ZIPFLAGS}     ||= '-Vu';
  1064.     $attribs{COMPRESS}     ||= 'gzip';
  1065.     $attribs{SUFFIX}       ||= '-gz';
  1066.     $attribs{SHAR}         ||= 'vms_share';
  1067.     $attribs{DIST_DEFAULT} ||= 'zipdist';
  1068.  
  1069.     $attribs{VERSION} =~ s/[^\w\$]/_/g;
  1070.     $attribs{NAME} =~ s/[^\w\$]/_/g;
  1071.  
  1072.     return ExtUtils::MM_Unix::dist($self,%attribs);
  1073. }
  1074.  
  1075. =item c_o (override)
  1076.  
  1077. Use VMS syntax on command line.  In particular, $(DEFINE) and
  1078. $(PERL_INC) have been pulled into $(CCCMD).  Also use MM[SK] macros.
  1079.  
  1080. =cut
  1081.  
  1082. sub c_o {
  1083.     my($self) = @_;
  1084.     return '' unless $self->needs_linking();
  1085.     '
  1086. .c$(OBJ_EXT) :
  1087.     $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
  1088.  
  1089. .cpp$(OBJ_EXT) :
  1090.     $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp
  1091.  
  1092. .cxx$(OBJ_EXT) :
  1093.     $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx
  1094.  
  1095. ';
  1096. }
  1097.  
  1098. =item xs_c (override)
  1099.  
  1100. Use MM[SK] macros.
  1101.  
  1102. =cut
  1103.  
  1104. sub xs_c {
  1105.     my($self) = @_;
  1106.     return '' unless $self->needs_linking();
  1107.     '
  1108. .xs.c :
  1109.     $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET)
  1110. ';
  1111. }
  1112.  
  1113. =item xs_o (override)
  1114.  
  1115. Use MM[SK] macros, and VMS command line for C compiler.
  1116.  
  1117. =cut
  1118.  
  1119. sub xs_o {    # many makes are too dumb to use xs_c then c_o
  1120.     my($self) = @_;
  1121.     return '' unless $self->needs_linking();
  1122.     '
  1123. .xs$(OBJ_EXT) :
  1124.     $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c
  1125.     $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
  1126. ';
  1127. }
  1128.  
  1129. =item top_targets (override)
  1130.  
  1131. Use VMS quoting on command line for Version_check.
  1132.  
  1133. =cut
  1134.  
  1135. sub top_targets {
  1136.     my($self) = shift;
  1137.     my(@m);
  1138.     push @m, '
  1139. all :: pure_all manifypods
  1140.     $(NOECHO) $(NOOP)
  1141.  
  1142. pure_all :: config pm_to_blib subdirs linkext
  1143.     $(NOECHO) $(NOOP)
  1144.  
  1145. subdirs :: $(MYEXTLIB)
  1146.     $(NOECHO) $(NOOP)
  1147.  
  1148. config :: $(MAKEFILE) $(INST_LIBDIR).exists
  1149.     $(NOECHO) $(NOOP)
  1150.  
  1151. config :: $(INST_ARCHAUTODIR).exists
  1152.     $(NOECHO) $(NOOP)
  1153.  
  1154. config :: $(INST_AUTODIR).exists
  1155.     $(NOECHO) $(NOOP)
  1156. ';
  1157.  
  1158.     push @m, q{
  1159. config :: Version_check
  1160.     $(NOECHO) $(NOOP)
  1161.  
  1162. } unless $self->{PARENT} or ($self->{PERL_SRC} && $self->{INSTALLDIRS} eq "perl") or $self->{NO_VC};
  1163.  
  1164.  
  1165.     push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]);
  1166.     if (%{$self->{MAN1PODS}}) {
  1167.     push @m, q[
  1168. config :: $(INST_MAN1DIR).exists
  1169.     $(NOECHO) $(NOOP)
  1170. ];
  1171.     push @m, $self->dir_target(qw[$(INST_MAN1DIR)]);
  1172.     }
  1173.     if (%{$self->{MAN3PODS}}) {
  1174.     push @m, q[
  1175. config :: $(INST_MAN3DIR).exists
  1176.     $(NOECHO) $(NOOP)
  1177. ];
  1178.     push @m, $self->dir_target(qw[$(INST_MAN3DIR)]);
  1179.     }
  1180.  
  1181.     push @m, '
  1182. $(O_FILES) : $(H_FILES)
  1183. ' if @{$self->{O_FILES} || []} && @{$self->{H} || []};
  1184.  
  1185.     push @m, q{
  1186. help :
  1187.     perldoc ExtUtils::MakeMaker
  1188. };
  1189.  
  1190.     push @m, q{
  1191. Version_check :
  1192.     $(NOECHO) $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -
  1193.     "-MExtUtils::MakeMaker=Version_check" -e "&Version_check('$(MM_VERSION)')"
  1194. };
  1195.  
  1196.     join('',@m);
  1197. }
  1198.  
  1199. =item dlsyms (override)
  1200.  
  1201. Create VMS linker options files specifying universal symbols for this
  1202. extension's shareable image, and listing other shareable images or 
  1203. libraries to which it should be linked.
  1204.  
  1205. =cut
  1206.  
  1207. sub dlsyms {
  1208.     my($self,%attribs) = @_;
  1209.  
  1210.     return '' unless $self->needs_linking();
  1211.  
  1212.     my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
  1213.     my($vars)  = $attribs{DL_VARS}  || $self->{DL_VARS}  || [];
  1214.     my($srcdir)= $attribs{PERL_SRC} || $self->{PERL_SRC} || '';
  1215.     my(@m);
  1216.  
  1217.     unless ($self->{SKIPHASH}{'dynamic'}) {
  1218.     push(@m,'
  1219. dynamic :: rtls.opt $(INST_ARCHAUTODIR)$(BASEEXT).opt
  1220.     $(NOECHO) $(NOOP)
  1221. ');
  1222.     if ($srcdir) {
  1223.        my($popt) = $self->catfile($srcdir,'perlshr.opt');
  1224.        my($lopt) = $self->catfile($srcdir,'crtl.opt');
  1225.        push(@m,"# Depend on \$(BASEEXT).opt to insure we copy here *after* autogenerating (wrong) rtls.opt in Mksymlists
  1226. rtls.opt : $popt $lopt \$(BASEEXT).opt
  1227.     Copy/Log $popt Sys\$Disk:[]rtls.opt
  1228.     Append/Log $lopt Sys\$Disk:[]rtls.opt
  1229. ");
  1230.     }
  1231.     else {
  1232.         push(@m,'
  1233. rtls.opt : $(BASEEXT).opt
  1234.     $(TOUCH) $(MMS$TARGET)
  1235. ');
  1236.     }
  1237.     }
  1238.  
  1239.     push(@m,'
  1240. static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
  1241.     $(NOECHO) $(NOOP)
  1242. ') unless $self->{SKIPHASH}{'static'};
  1243.  
  1244.     push(@m,'
  1245. $(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt
  1246.     $(CP) $(MMS$SOURCE) $(MMS$TARGET)
  1247.  
  1248. $(BASEEXT).opt : Makefile.PL
  1249.     $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Mksymlists;" -
  1250.     ',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ],
  1251.     neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),')"
  1252.     $(PERL) -e "print ""$(INST_STATIC)/Include=$(BASEEXT)\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)
  1253. ');
  1254.  
  1255.     if (length $self->{LDLOADLIBS}) {
  1256.     my($lib); my($line) = '';
  1257.     foreach $lib (split ' ', $self->{LDLOADLIBS}) {
  1258.         $lib =~ s%\$%\\\$%g;  # Escape '$' in VMS filespecs
  1259.         if (length($line) + length($lib) > 160) {
  1260.         push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n";
  1261.         $line = $lib . '\n';
  1262.         }
  1263.         else { $line .= $lib . '\n'; }
  1264.     }
  1265.     push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line;
  1266.     }
  1267.  
  1268.     join('',@m);
  1269.  
  1270. }
  1271.  
  1272. =item dynamic_lib (override)
  1273.  
  1274. Use VMS Link command.
  1275.  
  1276. =cut
  1277.  
  1278. sub dynamic_lib {
  1279.     my($self, %attribs) = @_;
  1280.     return '' unless $self->needs_linking(); #might be because of a subdir
  1281.  
  1282.     return '' unless $self->has_link_code();
  1283.  
  1284.     my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
  1285.     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
  1286.     my(@m);
  1287.     push @m,"
  1288.  
  1289. OTHERLDFLAGS = $otherldflags
  1290. INST_DYNAMIC_DEP = $inst_dynamic_dep
  1291.  
  1292. ";
  1293.     push @m, '
  1294. $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt rtls.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
  1295.     $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
  1296.     $(NOECHO) If F$TrnLNm("PerlShr").eqs."" Then Define/NoLog/User PerlShr Sys$Share:PerlShr.',$Config{'dlext'},'
  1297.     Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,rtls.opt/Option,$(PERL_INC)perlshr_attr.opt/Option
  1298. ';
  1299.  
  1300.     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
  1301.     join('',@m);
  1302. }
  1303.  
  1304. =item dynamic_bs (override)
  1305.  
  1306. Use VMS-style quoting on Mkbootstrap command line.
  1307.  
  1308. =cut
  1309.  
  1310. sub dynamic_bs {
  1311.     my($self, %attribs) = @_;
  1312.     return '
  1313. BOOTSTRAP =
  1314. ' unless $self->has_link_code();
  1315.     '
  1316. BOOTSTRAP = '."$self->{BASEEXT}.bs".'
  1317.  
  1318. $(BOOTSTRAP) : $(MAKEFILE) '."$self->{BOOTDEP}".' $(INST_ARCHAUTODIR).exists
  1319.     $(NOECHO) $(SAY) "Running mkbootstrap for $(NAME) ($(BSLOADLIBS))"
  1320.     $(NOECHO) $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -
  1321.     -e "use ExtUtils::Mkbootstrap; Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
  1322.     $(NOECHO) $(TOUCH) $(MMS$TARGET)
  1323.  
  1324. $(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR).exists
  1325.     $(NOECHO) $(RM_RF) $(INST_BOOT)
  1326.     - $(CP) $(BOOTSTRAP) $(INST_BOOT)
  1327. ';
  1328. }
  1329.  
  1330. =item static_lib (override)
  1331.  
  1332. Use VMS commands to manipulate object library.
  1333.  
  1334. =cut
  1335.  
  1336. sub static_lib {
  1337.     my($self) = @_;
  1338.     return '' unless $self->needs_linking();
  1339.  
  1340.     return '
  1341. $(INST_STATIC) :
  1342.     $(NOECHO) $(NOOP)
  1343. ' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB});
  1344.  
  1345.     my(@m);
  1346.     push @m,'
  1347. $(OBJECT) : $(INST_ARCHAUTODIR).exists
  1348.  
  1349. $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
  1350. ';
  1351.     push(@m, '    $(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB};
  1352.  
  1353.     push(@m,'
  1354.     If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)
  1355.     Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)
  1356.     $(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;"
  1357. ');
  1358.     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
  1359.     join('',@m);
  1360. }
  1361.  
  1362.  
  1363.  
  1364. =item manifypods (override)
  1365.  
  1366. Use VMS-style quoting on command line, and VMS logical name
  1367. to specify fallback location at build time if we can't find pod2man.
  1368.  
  1369. =cut
  1370.  
  1371.  
  1372. sub manifypods {
  1373.     my($self, %attribs) = @_;
  1374.     return "\nmanifypods :\n\t\$(NOECHO) \$(NOOP)\n" unless %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};
  1375.     my($dist);
  1376.     my($pod2man_exe);
  1377.     if (defined $self->{PERL_SRC}) {
  1378.     $pod2man_exe = $self->catfile($self->{PERL_SRC},'pod','pod2man');
  1379.     } else {
  1380.     $pod2man_exe = $self->catfile($Config{scriptdirexp},'pod2man');
  1381.     }
  1382.     if (not ($pod2man_exe = $self->perl_script($pod2man_exe))) {
  1383.     print <<END;
  1384.  
  1385. Warning: I could not locate your pod2man program.  As a last choice,
  1386.          I will look for the file to which the logical name POD2MAN
  1387.          points when MMK is invoked.
  1388.  
  1389. END
  1390.         $pod2man_exe = "pod2man";
  1391.     }
  1392.     my(@m);
  1393.     push @m,
  1394. qq[POD2MAN_EXE = $pod2man_exe\n],
  1395. q[POD2MAN = $(PERL) -we "%m=@ARGV;for (keys %m){" -
  1396. -e "system(""MCR $^X $(POD2MAN_EXE) $_ >$m{$_}"");}"
  1397. ];
  1398.     push @m, "\nmanifypods : \$(MAN1PODS) \$(MAN3PODS)\n";
  1399.     if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) {
  1400.     my($pod);
  1401.     foreach $pod (sort keys %{$self->{MAN1PODS}}) {
  1402.         push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
  1403.         push @m, "$pod $self->{MAN1PODS}{$pod}\n";
  1404.     }
  1405.     foreach $pod (sort keys %{$self->{MAN3PODS}}) {
  1406.         push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
  1407.         push @m, "$pod $self->{MAN3PODS}{$pod}\n";
  1408.     }
  1409.     }
  1410.     join('', @m);
  1411. }
  1412.  
  1413. =item processPL (override)
  1414.  
  1415. Use VMS-style quoting on command line.
  1416.  
  1417. =cut
  1418.  
  1419. sub processPL {
  1420.     my($self) = @_;
  1421.     return "" unless $self->{PL_FILES};
  1422.     my(@m, $plfile);
  1423.     foreach $plfile (sort keys %{$self->{PL_FILES}}) {
  1424.     my $vmsplfile = vmsify($plfile);
  1425.     my $vmsfile = vmsify($self->{PL_FILES}->{$plfile});
  1426.     push @m, "
  1427. all :: $vmsfile
  1428.     \$(NOECHO) \$(NOOP)
  1429.  
  1430. $vmsfile :: $vmsplfile
  1431. ",'    $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $vmsplfile
  1432. ";
  1433.     }
  1434.     join "", @m;
  1435. }
  1436.  
  1437. =item installbin (override)
  1438.  
  1439. Stay under DCL's 255 character command line limit once again by
  1440. splitting potentially long list of files across multiple lines
  1441. in C<realclean> target.
  1442.  
  1443. =cut
  1444.  
  1445. sub installbin {
  1446.     my($self) = @_;
  1447.     return '' unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY";
  1448.     return '' unless @{$self->{EXE_FILES}};
  1449.     my(@m, $from, $to, %fromto, @to, $line);
  1450.     my(@exefiles) = map { vmsify($_) } @{$self->{EXE_FILES}};
  1451.     for $from (@exefiles) {
  1452.     my($path) = '$(INST_SCRIPT)' . basename($from);
  1453.     local($_) = $path;  # backward compatibility
  1454.     $to = $self->libscan($path);
  1455.     print "libscan($from) => '$to'\n" if ($Verbose >=2);
  1456.     $fromto{$from} = vmsify($to);
  1457.     }
  1458.     @to = values %fromto;
  1459.     push @m, "
  1460. EXE_FILES = @exefiles
  1461.  
  1462. all :: @to
  1463.     \$(NOECHO) \$(NOOP)
  1464.  
  1465. realclean ::
  1466. ";
  1467.     $line = '';  #avoid unitialized var warning
  1468.     foreach $to (@to) {
  1469.     if (length($line) + length($to) > 80) {
  1470.         push @m, "\t\$(RM_F) $line\n";
  1471.         $line = $to;
  1472.     }
  1473.     else { $line .= " $to"; }
  1474.     }
  1475.     push @m, "\t\$(RM_F) $line\n\n" if $line;
  1476.  
  1477.     while (($from,$to) = each %fromto) {
  1478.     last unless defined $from;
  1479.     my $todir;
  1480.     if ($to =~ m#[/>:\]]#) { $todir = dirname($to); }
  1481.     else                   { ($todir = $to) =~ s/[^\)]+$//; }
  1482.     $todir = $self->fixpath($todir,1);
  1483.     push @m, "
  1484. $to : $from \$(MAKEFILE) ${todir}.exists
  1485.     \$(CP) $from $to
  1486.  
  1487. ", $self->dir_target($todir);
  1488.     }
  1489.     join "", @m;
  1490. }
  1491.  
  1492. =item subdir_x (override)
  1493.  
  1494. Use VMS commands to change default directory.
  1495.  
  1496. =cut
  1497.  
  1498. sub subdir_x {
  1499.     my($self, $subdir) = @_;
  1500.     my(@m,$key);
  1501.     $subdir = $self->fixpath($subdir,1);
  1502.     push @m, '
  1503.  
  1504. subdirs ::
  1505.     olddef = F$Environment("Default")
  1506.     Set Default ',$subdir,'
  1507.     - $(MMS)$(MMSQUALIFIERS) all $(USEMACROS)$(PASTHRU)$(MACROEND)
  1508.     Set Default \'olddef\'
  1509. ';
  1510.     join('',@m);
  1511. }
  1512.  
  1513. =item clean (override)
  1514.  
  1515. Split potentially long list of files across multiple commands (in
  1516. order to stay under the magic command line limit).  Also use MM[SK]
  1517. commands for handling subdirectories.
  1518.  
  1519. =cut
  1520.  
  1521. sub clean {
  1522.     my($self, %attribs) = @_;
  1523.     my(@m,$dir);
  1524.     push @m, '
  1525. clean ::
  1526. ';
  1527.     foreach $dir (@{$self->{DIR}}) { # clean subdirectories first
  1528.     my($vmsdir) = $self->fixpath($dir,1);
  1529.     push( @m, '    If F$Search("'.$vmsdir.'$(MAKEFILE)").nes."" Then \\',"\n\t",
  1530.           '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) clean`;"',"\n");
  1531.     }
  1532.     push @m, '    $(RM_F) *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *$(OBJ_EXT) *$(LIB_EXT) *.Opt $(BOOTSTRAP) $(BASEEXT).bso .MM_Tmp
  1533. ';
  1534.  
  1535.     my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files
  1536.     if ($attribs{FILES}) {
  1537.     my($word,$key,@filist);
  1538.     if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
  1539.     else { @filist = split /\s+/, $attribs{FILES}; }
  1540.     foreach $word (@filist) {
  1541.         if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
  1542.         push(@otherfiles, @{$self->{$key}});
  1543.         }
  1544.         else { push(@otherfiles, $attribs{FILES}); }
  1545.     }
  1546.     }
  1547.     push(@otherfiles, qw[ blib $(MAKE_APERL_FILE) extralibs.ld perlmain.c pm_to_blib.ts ]);
  1548.     push(@otherfiles,$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
  1549.     my($file,$line);
  1550.     $line = '';  #avoid unitialized var warning
  1551.     foreach $file (@otherfiles) {
  1552.     $file = $self->fixpath($file);
  1553.     if (length($line) + length($file) > 80) {
  1554.         push @m, "\t\$(RM_RF) $line\n";
  1555.         $line = "$file";
  1556.     }
  1557.     else { $line .= " $file"; }
  1558.     }
  1559.     push @m, "\t\$(RM_RF) $line\n" if $line;
  1560.     push(@m, "    $attribs{POSTOP}\n") if $attribs{POSTOP};
  1561.     join('', @m);
  1562. }
  1563.  
  1564. =item realclean (override)
  1565.  
  1566. Guess what we're working around?  Also, use MM[SK] for subdirectories.
  1567.  
  1568. =cut
  1569.  
  1570. sub realclean {
  1571.     my($self, %attribs) = @_;
  1572.     my(@m);
  1573.     push(@m,'
  1574. realclean :: clean
  1575. ');
  1576.     foreach(@{$self->{DIR}}){
  1577.     my($vmsdir) = $self->fixpath($_,1);
  1578.     push(@m, '    If F$Search("'."$vmsdir".'$(MAKEFILE)").nes."" Then \\',"\n\t",
  1579.           '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) realclean`;"',"\n");
  1580.     }
  1581.     push @m,'    $(RM_RF) $(INST_AUTODIR) $(INST_ARCHAUTODIR)
  1582. ';
  1583.     my($file,$line,$fcnt);
  1584.     my(@files) = qw{ $(MAKEFILE) $(MAKEFILE)_old };
  1585.     if ($self->has_link_code) {
  1586.     push(@files,qw{ $(INST_DYNAMIC) $(INST_STATIC) $(INST_BOOT) $(OBJECT) });
  1587.     }
  1588.     push(@files, values %{$self->{PM}});
  1589.     $line = '';  #avoid unitialized var warning
  1590.     foreach $file (@files) {
  1591.     $file = $self->fixpath($file);
  1592.     if (length($line) + length($file) > 80 || ++$fcnt >= 2) {
  1593.         push @m, "\t\$(RM_F) $line\n";
  1594.         $line = "$file";
  1595.         $fcnt = 0;
  1596.     }
  1597.     else { $line .= " $file"; }
  1598.     }
  1599.     push @m, "\t\$(RM_F) $line\n" if $line;
  1600.     if ($attribs{FILES}) {
  1601.     my($word,$key,@filist,@allfiles);
  1602.     if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
  1603.     else { @filist = split /\s+/, $attribs{FILES}; }
  1604.     foreach $word (@filist) {
  1605.         if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
  1606.         push(@allfiles, @{$self->{$key}});
  1607.         }
  1608.         else { push(@allfiles, $attribs{FILES}); }
  1609.     }
  1610.     $line = '';
  1611.     foreach $file (@allfiles) {
  1612.         $file = $self->fixpath($file);
  1613.         if (length($line) + length($file) > 80) {
  1614.         push @m, "\t\$(RM_RF) $line\n";
  1615.         $line = "$file";
  1616.         }
  1617.         else { $line .= " $file"; }
  1618.     }
  1619.     push @m, "\t\$(RM_RF) $line\n" if $line;
  1620.     }
  1621.     push(@m, "    $attribs{POSTOP}\n")                     if $attribs{POSTOP};
  1622.     join('', @m);
  1623. }
  1624.  
  1625. =item dist_basics (override)
  1626.  
  1627. Use VMS-style quoting on command line.
  1628.  
  1629. =cut
  1630.  
  1631. sub dist_basics {
  1632.     my($self) = @_;
  1633. '
  1634. distclean :: realclean distcheck
  1635.     $(NOECHO) $(NOOP)
  1636.  
  1637. distcheck :
  1638.     $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&fullcheck\'; fullcheck()"
  1639.  
  1640. skipcheck :
  1641.     $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&skipcheck\'; skipcheck()"
  1642.  
  1643. manifest :
  1644.     $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&mkmanifest\'; mkmanifest()"
  1645. ';
  1646. }
  1647.  
  1648. =item dist_core (override)
  1649.  
  1650. Syntax for invoking F<VMS_Share> differs from that for Unix F<shar>,
  1651. so C<shdist> target actions are VMS-specific.
  1652.  
  1653. =cut
  1654.  
  1655. sub dist_core {
  1656.     my($self) = @_;
  1657. q[
  1658. dist : $(DIST_DEFAULT)
  1659.     $(NOECHO) $(PERL) -le "print 'Warning: $m older than $vf' if -e ($vf = '$(VERSION_FROM)') && -M $vf < -M ($m = '$(MAKEFILE)')"
  1660.  
  1661. zipdist : $(DISTVNAME).zip
  1662.     $(NOECHO) $(NOOP)
  1663.  
  1664. $(DISTVNAME).zip : distdir
  1665.     $(PREOP)
  1666.     $(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*;
  1667.     $(RM_RF) $(DISTVNAME)
  1668.     $(POSTOP)
  1669.  
  1670. $(DISTVNAME).tar$(SUFFIX) : distdir
  1671.     $(PREOP)
  1672.     $(TO_UNIX)
  1673.     $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)]
  1674.     $(RM_RF) $(DISTVNAME)
  1675.     $(COMPRESS) $(DISTVNAME).tar
  1676.     $(POSTOP)
  1677.  
  1678. shdist : distdir
  1679.     $(PREOP)
  1680.     $(SHAR) [.$(DISTVNAME...]*.*; $(DISTVNAME).share
  1681.     $(RM_RF) $(DISTVNAME)
  1682.     $(POSTOP)
  1683. ];
  1684. }
  1685.  
  1686. =item dist_dir (override)
  1687.  
  1688. Use VMS-style quoting on command line.
  1689.  
  1690. =cut
  1691.  
  1692. sub dist_dir {
  1693.     my($self) = @_;
  1694. q{
  1695. distdir :
  1696.     $(RM_RF) $(DISTVNAME)
  1697.     $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest '/mani/';" \\
  1698.     -e "manicopy(maniread(),'$(DISTVNAME)','$(DIST_CP)');"
  1699. };
  1700. }
  1701.  
  1702. =item dist_test (override)
  1703.  
  1704. Use VMS commands to change default directory, and use VMS-style
  1705. quoting on command line.
  1706.  
  1707. =cut
  1708.  
  1709. sub dist_test {
  1710.     my($self) = @_;
  1711. q{
  1712. disttest : distdir
  1713.     startdir = F$Environment("Default")
  1714.     Set Default [.$(DISTVNAME)]
  1715.     $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL
  1716.     $(MMS)$(MMSQUALIFIERS)
  1717.     $(MMS)$(MMSQUALIFIERS) test
  1718.     Set Default 'startdir'
  1719. };
  1720. }
  1721.  
  1722.  
  1723. =item install (override)
  1724.  
  1725. Work around DCL's 255 character limit several times,and use
  1726. VMS-style command line quoting in a few cases.
  1727.  
  1728. =cut
  1729.  
  1730. sub install {
  1731.     my($self, %attribs) = @_;
  1732.     my(@m,@docfiles);
  1733.  
  1734.     if ($self->{EXE_FILES}) {
  1735.     my($line,$file) = ('','');
  1736.     foreach $file (@{$self->{EXE_FILES}}) {
  1737.         $line .= "$file ";
  1738.         if (length($line) > 128) {
  1739.         push(@docfiles,qq[\t\$(PERL) -e "print '$line'" >>.MM_tmp\n]);
  1740.         $line = '';
  1741.         }
  1742.     }
  1743.     push(@docfiles,qq[\t\$(PERL) -e "print '$line'" >>.MM_tmp\n]) if $line;
  1744.     }
  1745.  
  1746.     push @m, q[
  1747. install :: all pure_install doc_install
  1748.     $(NOECHO) $(NOOP)
  1749.  
  1750. install_perl :: all pure_perl_install doc_perl_install
  1751.     $(NOECHO) $(NOOP)
  1752.  
  1753. install_site :: all pure_site_install doc_site_install
  1754.     $(NOECHO) $(NOOP)
  1755.  
  1756. install_ :: install_site
  1757.     $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
  1758.  
  1759. pure_install :: pure_$(INSTALLDIRS)_install
  1760.     $(NOECHO) $(NOOP)
  1761.  
  1762. doc_install :: doc_$(INSTALLDIRS)_install
  1763.     $(NOECHO) $(SAY) "Appending installation info to $(INSTALLARCHLIB)perllocal.pod"
  1764.  
  1765. pure__install : pure_site_install
  1766.     $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
  1767.  
  1768. doc__install : doc_site_install
  1769.     $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
  1770.  
  1771. pure_perl_install ::
  1772.     $(NOECHO) $(PERL) -e "print 'read ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
  1773.     $(NOECHO) $(PERL) -e "print 'write ].$self->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
  1774.     $(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLPRIVLIB) '" >>.MM_tmp
  1775.     $(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLARCHLIB) '" >>.MM_tmp
  1776.     $(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
  1777.     $(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
  1778.     $(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
  1779.     $(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
  1780.     $(MOD_INSTALL) <.MM_tmp
  1781.     $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
  1782.     $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[
  1783.  
  1784. pure_site_install ::
  1785.     $(NOECHO) $(PERL) -e "print 'read ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
  1786.     $(NOECHO) $(PERL) -e "print 'write ].$self->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
  1787.     $(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLSITELIB) '" >>.MM_tmp
  1788.     $(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLSITEARCH) '" >>.MM_tmp
  1789.     $(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
  1790.     $(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
  1791.     $(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
  1792.     $(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
  1793.     $(MOD_INSTALL) <.MM_tmp
  1794.     $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
  1795.     $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
  1796.  
  1797. doc_perl_install ::
  1798.     $(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLPRIVLIB)|'" >.MM_tmp
  1799.     $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp
  1800. ],@docfiles,
  1801. q%    $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
  1802.     $(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
  1803.     $(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
  1804.     $(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
  1805.     $(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
  1806.     $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp;
  1807.  
  1808. doc_site_install ::
  1809.     $(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLSITELIB)|'" >.MM_tmp
  1810.     $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp
  1811. ],@docfiles,
  1812. q%    $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
  1813.     $(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
  1814.     $(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
  1815.     $(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
  1816.     $(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
  1817.     $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp;
  1818.  
  1819. ];
  1820.  
  1821.     push @m, q[
  1822. uninstall :: uninstall_from_$(INSTALLDIRS)dirs
  1823.     $(NOECHO) $(NOOP)
  1824.  
  1825. uninstall_from_perldirs ::
  1826.     $(NOECHO) $(UNINSTALL) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
  1827.     $(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes."
  1828.     $(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove"
  1829.     $(NOECHO) $(SAY) "the appropriate files.  Sorry for the inconvenience."
  1830.  
  1831. uninstall_from_sitedirs ::
  1832.     $(NOECHO) $(UNINSTALL) ],$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist'),"\n",q[
  1833.     $(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes."
  1834.     $(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove"
  1835.     $(NOECHO) $(SAY) "the appropriate files.  Sorry for the inconvenience."
  1836. ];
  1837.  
  1838.     join('',@m);
  1839. }
  1840.  
  1841. =item perldepend (override)
  1842.  
  1843. Use VMS-style syntax for files; it's cheaper to just do it directly here
  1844. than to have the MM_Unix method call C<catfile> repeatedly.  Also use
  1845. config.vms as source of original config data if the Perl distribution
  1846. is available; config.sh is an ancillary file under VMS.  Finally, if
  1847. we have to rebuild Config.pm, use MM[SK] to do it.
  1848.  
  1849. =cut
  1850.  
  1851. sub perldepend {
  1852.     my($self) = @_;
  1853.     my(@m);
  1854.  
  1855.     push @m, '
  1856. $(OBJECT) : $(PERL_INC)EXTERN.h, $(PERL_INC)INTERN.h, $(PERL_INC)XSUB.h, $(PERL_INC)av.h
  1857. $(OBJECT) : $(PERL_INC)cop.h, $(PERL_INC)cv.h, $(PERL_INC)embed.h, $(PERL_INC)form.h
  1858. $(OBJECT) : $(PERL_INC)gv.h, $(PERL_INC)handy.h, $(PERL_INC)hv.h, $(PERL_INC)keywords.h
  1859. $(OBJECT) : $(PERL_INC)mg.h, $(PERL_INC)op.h, $(PERL_INC)opcode.h, $(PERL_INC)patchlevel.h
  1860. $(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perly.h, $(PERL_INC)pp.h, $(PERL_INC)proto.h
  1861. $(OBJECT) : $(PERL_INC)regcomp.h, $(PERL_INC)regexp.h, $(PERL_INC)scope.h, $(PERL_INC)sv.h
  1862. $(OBJECT) : $(PERL_INC)vmsish.h, $(PERL_INC)util.h, $(PERL_INC)config.h
  1863.  
  1864. ' if $self->{OBJECT}; 
  1865.  
  1866.     if ($self->{PERL_SRC}) {
  1867.     my(@macros);
  1868.     my($mmsquals) = '$(USEMAKEFILE)[.vms]$(MAKEFILE)';
  1869.     push(@macros,'__AXP__=1') if $Config{'arch'} eq 'VMS_AXP';
  1870.     push(@macros,'DECC=1')    if $Config{'vms_cc_type'} eq 'decc';
  1871.     push(@macros,'GNUC=1')    if $Config{'vms_cc_type'} eq 'gcc';
  1872.     push(@macros,'SOCKET=1')  if $Config{'d_has_sockets'};
  1873.     push(@macros,qq["CC=$Config{'cc'}"])  if $Config{'cc'} =~ m!/!;
  1874.     $mmsquals .= '$(USEMACROS)' . join(',',@macros) . '$(MACROEND)' if @macros;
  1875.     push(@m,q[
  1876. $(PERL_INC)config.h : $(PERL_VMS)config.vms
  1877.     $(NOECHO) Write Sys$Error "Warning: $(PERL_INC)config.h out of date with $(PERL_VMS)config.vms"
  1878.  
  1879. $(PERL_ARCHLIB)Config.pm : $(PERL_VMS)config.vms $(PERL_VMS)genconfig.pl
  1880.     $(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.vms or genconfig.pl"
  1881.     olddef = F$Environment("Default")
  1882.     Set Default $(PERL_SRC)
  1883.     $(MMS)],$mmsquals,);
  1884.     if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) {
  1885.         my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm'));
  1886.         $target =~ s/\Q$prefix/[/;
  1887.         push(@m," $target");
  1888.     }
  1889.     else { push(@m,' $(MMS$TARGET)'); }
  1890.     push(@m,q[
  1891.     Set Default 'olddef'
  1892. ]);
  1893.     }
  1894.  
  1895.     push(@m, join(" ", map($self->fixpath($_),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
  1896.       if %{$self->{XS}};
  1897.  
  1898.     join('',@m);
  1899. }
  1900.  
  1901. =item makefile (override)
  1902.  
  1903. Use VMS commands and quoting.
  1904.  
  1905. =cut
  1906.  
  1907. sub makefile {
  1908.     my($self) = @_;
  1909.     my(@m,@cmd);
  1910.     push @m, q[
  1911. $(OBJECT) : $(FIRST_MAKEFILE)
  1912. ] if $self->{OBJECT};
  1913.  
  1914.     push @m,q[
  1915. $(MAKEFILE) : Makefile.PL $(CONFIGDEP)
  1916.     $(NOECHO) $(SAY) "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)"
  1917.     $(NOECHO) $(SAY) "Cleaning current config before rebuilding $(MAKEFILE) ..."
  1918.     - $(MV) $(MAKEFILE) $(MAKEFILE)_old
  1919.     - $(MMS)$(MMSQUALIFIERS) $(USEMAKEFILE)$(MAKEFILE)_old clean
  1920.     $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL ],join(' ',map(qq["$_"],@ARGV)),q[
  1921.     $(NOECHO) $(SAY) "$(MAKEFILE) has been rebuilt."
  1922.     $(NOECHO) $(SAY) "Please run $(MMS) to build the extension."
  1923. ];
  1924.  
  1925.     join('',@m);
  1926. }
  1927.  
  1928. =item test (override)
  1929.  
  1930. Use VMS commands for handling subdirectories.
  1931.  
  1932. =cut
  1933.  
  1934. sub test {
  1935.     my($self, %attribs) = @_;
  1936.     my($tests) = $attribs{TESTS} || ( -d 't' ? 't/*.t' : '');
  1937.     my(@m);
  1938.     push @m,"
  1939. TEST_VERBOSE = 0
  1940. TEST_TYPE = test_\$(LINKTYPE)
  1941. TEST_FILE = test.pl
  1942. TESTDB_SW = -d
  1943.  
  1944. test :: \$(TEST_TYPE)
  1945.     \$(NOECHO) \$(NOOP)
  1946.  
  1947. testdb :: testdb_\$(LINKTYPE)
  1948.     \$(NOECHO) \$(NOOP)
  1949.  
  1950. ";
  1951.     foreach(@{$self->{DIR}}){
  1952.       my($vmsdir) = $self->fixpath($_,1);
  1953.       push(@m, '    If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
  1954.            '; print `$(MMS)$(MMSQUALIFIERS) $(PASTHRU2) test`'."\n");
  1955.     }
  1956.     push(@m, "\t\$(NOECHO) \$(SAY) \"No tests defined for \$(NAME) extension.\"\n")
  1957.         unless $tests or -f "test.pl" or @{$self->{DIR}};
  1958.     push(@m, "\n");
  1959.  
  1960.     push(@m, "test_dynamic :: pure_all\n");
  1961.     push(@m, $self->test_via_harness('$(FULLPERL)', $tests)) if $tests;
  1962.     push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl";
  1963.     push(@m, "\t\$(NOECHO) \$(NOOP)\n") if (!$tests && ! -f "test.pl");
  1964.     push(@m, "\n");
  1965.  
  1966.     push(@m, "testdb_dynamic :: pure_all\n");
  1967.     push(@m, $self->test_via_script('$(FULLPERL) "$(TESTDB_SW)"', '$(TEST_FILE)'));
  1968.     push(@m, "\n");
  1969.  
  1970.     push @m, "test_ : test_dynamic\n\n";
  1971.  
  1972.     if ($self->needs_linking()) {
  1973.     push(@m, "test_static :: pure_all \$(MAP_TARGET)\n");
  1974.     push(@m, $self->test_via_harness('$(MAP_TARGET)', $tests)) if $tests;
  1975.     push(@m, $self->test_via_script('$(MAP_TARGET)', 'test.pl')) if -f 'test.pl';
  1976.     push(@m, "\n");
  1977.     push(@m, "testdb_static :: pure_all \$(MAP_TARGET)\n");
  1978.     push(@m, $self->test_via_script('$(MAP_TARGET) $(TESTDB_SW)', '$(TEST_FILE)'));
  1979.     push(@m, "\n");
  1980.     }
  1981.     else {
  1982.     push @m, "test_static :: test_dynamic\n\t\$(NOECHO) \$(NOOP)\n\n";
  1983.     push @m, "testdb_static :: testdb_dynamic\n\t\$(NOECHO) \$(NOOP)\n";
  1984.     }
  1985.  
  1986.     join('',@m);
  1987. }
  1988.  
  1989. =item test_via_harness (override)
  1990.  
  1991. Use VMS-style quoting on command line.
  1992.  
  1993. =cut
  1994.  
  1995. sub test_via_harness {
  1996.     my($self,$perl,$tests) = @_;
  1997.     "    $perl".' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)" \\'."\n\t".
  1998.     '-e "use Test::Harness qw(&runtests $verbose); $verbose=$(TEST_VERBOSE); runtests @ARGV;" \\'."\n\t$tests\n";
  1999. }
  2000.  
  2001. =item test_via_script (override)
  2002.  
  2003. Use VMS-style quoting on command line.
  2004.  
  2005. =cut
  2006.  
  2007. sub test_via_script {
  2008.     my($self,$perl,$script) = @_;
  2009.     "    $perl".' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '.$script.'
  2010. ';
  2011. }
  2012.  
  2013. =item makeaperl (override)
  2014.  
  2015. Undertake to build a new set of Perl images using VMS commands.  Since
  2016. VMS does dynamic loading, it's not necessary to statically link each
  2017. extension into the Perl image, so this isn't the normal build path.
  2018. Consequently, it hasn't really been tested, and may well be incomplete.
  2019.  
  2020. =cut
  2021.  
  2022. sub makeaperl {
  2023.     my($self, %attribs) = @_;
  2024.     my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmp, $libperl) = 
  2025.       @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
  2026.     my(@m);
  2027.     push @m, "
  2028. MAP_TARGET    = $target
  2029. ";
  2030.     return join '', @m if $self->{PARENT};
  2031.  
  2032.     my($dir) = join ":", @{$self->{DIR}};
  2033.  
  2034.     unless ($self->{MAKEAPERL}) {
  2035.     push @m, q{
  2036. $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
  2037.     $(NOECHO) $(SAY) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
  2038.     $(NOECHO) $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \
  2039.         Makefile.PL DIR=}, $dir, q{ \
  2040.         MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
  2041.         MAKEAPERL=1 NORECURS=1
  2042.  
  2043. $(MAP_TARGET) :: $(MAKE_APERL_FILE)
  2044.     $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
  2045. };
  2046.     push @m, map( " \\\n\t\t$_", @ARGV );
  2047.     push @m, "\n";
  2048.  
  2049.     return join '', @m;
  2050.     }
  2051.  
  2052.  
  2053.     my($linkcmd,@staticopts,@staticpkgs,$extralist,$targdir,$libperldir);
  2054.  
  2055.     $linkcmd = join ' ', $Config{'ld'},
  2056.         grep($_, @Config{qw(large split ldflags ccdlflags)});
  2057.     $linkcmd =~ s/\s+/ /g;
  2058.  
  2059.     local(%olbs);
  2060.     $olbs{$self->{INST_ARCHAUTODIR}} = "$self->{BASEEXT}\$(LIB_EXT)";
  2061.     require File::Find;
  2062.     File::Find::find(sub {
  2063.     return unless m/\Q$self->{LIB_EXT}\E$/;
  2064.     return if m/^libperl/;
  2065.  
  2066.     if( exists $self->{INCLUDE_EXT} ){
  2067.         my $found = 0;
  2068.         my $incl;
  2069.         my $xx;
  2070.  
  2071.         ($xx = $File::Find::name) =~ s,.*?/auto/,,;
  2072.         $xx =~ s,/?$_,,;
  2073.         $xx =~ s,/,::,g;
  2074.  
  2075.         foreach $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
  2076.             if( $xx eq $incl ){
  2077.                 $found++;
  2078.                 last;
  2079.             }
  2080.         }
  2081.         return unless $found;
  2082.     }
  2083.     elsif( exists $self->{EXCLUDE_EXT} ){
  2084.         my $excl;
  2085.         my $xx;
  2086.  
  2087.         ($xx = $File::Find::name) =~ s,.*?/auto/,,;
  2088.         $xx =~ s,/?$_,,;
  2089.         $xx =~ s,/,::,g;
  2090.  
  2091.         foreach $excl (@{$self->{EXCLUDE_EXT}}){
  2092.             return if( $xx eq $excl );
  2093.         }
  2094.     }
  2095.  
  2096.     $olbs{$ENV{DEFAULT}} = $_;
  2097.     }, grep( -d $_, @{$searchdirs || []}));
  2098.  
  2099.     $static = [] unless $static;
  2100.     @olbs{@{$static}} = (1) x @{$static};
  2101.  
  2102.     $extra = [] unless $extra && ref $extra eq 'ARRAY';
  2103.     for (sort keys %olbs) {
  2104.     next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
  2105.     my($dir) = $self->fixpath($_,1);
  2106.     my($extralibs) = $dir . "extralibs.ld";
  2107.     my($extopt) = $dir . $olbs{$_};
  2108.     $extopt =~ s/$self->{LIB_EXT}$/.opt/;
  2109.     if (-f $extralibs ) {
  2110.         open LIST,$extralibs or warn $!,next;
  2111.         push @$extra, <LIST>;
  2112.         close LIST;
  2113.     }
  2114.     if (-f $extopt) {
  2115.         open OPT,$extopt or die $!;
  2116.         while (<OPT>) {
  2117.         next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
  2118.         (my($pkg) = "$1_$1$self->{LIB_EXT}") =~ s#_*#/#g;
  2119.         push @staticpkgs,$pkg;
  2120.         }
  2121.         push @staticopts, $extopt;
  2122.     }
  2123.     }
  2124.  
  2125.     $target = "Perl$Config{'exe_ext'}" unless $target;
  2126.     ($shrtarget,$targdir) = fileparse($target);
  2127.     $shrtarget =~ s/^([^.]*)/$1Shr/;
  2128.     $shrtarget = $targdir . $shrtarget;
  2129.     $target = "Perlshr.$Config{'dlext'}" unless $target;
  2130.     $tmp = "[]" unless $tmp;
  2131.     $tmp = $self->fixpath($tmp,1);
  2132.     if (@$extra) {
  2133.     $extralist = join(' ',@$extra);
  2134.     $extralist =~ s/[,\s\n]+/, /g;
  2135.     }
  2136.     else { $extralist = ''; }
  2137.     if ($libperl) {
  2138.     unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
  2139.         print STDOUT "Warning: $libperl not found\n";
  2140.         undef $libperl;
  2141.     }
  2142.     }
  2143.     unless ($libperl) {
  2144.     if (defined $self->{PERL_SRC}) {
  2145.         $libperl = $self->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}");
  2146.     } elsif (-f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) {
  2147.     } else {
  2148.         print STDOUT "Warning: $libperl not found
  2149.     If you're going to build a static perl binary, make sure perl is installed
  2150.     otherwise ignore this warning\n";
  2151.     }
  2152.     }
  2153.     $libperldir = $self->fixpath((fileparse($libperl))[1],1);
  2154.  
  2155.     push @m, '
  2156. MAP_TARGET    = ',$self->fixpath($target),'
  2157. MAP_SHRTARGET = ',$self->fixpath($shrtarget),"
  2158. MAP_LINKCMD   = $linkcmd
  2159. MAP_PERLINC   = ", $perlinc ? map('"$_" ',@{$perlinc}) : '','
  2160. MAP_STATIC    = ',@staticopts ? join(' ', @staticopts) : '','
  2161. MAP_OPTS    = ',@staticopts ? ','.join(',', map($_.'/Option', @staticopts)) : '',"
  2162. MAP_EXTRA     = $extralist
  2163. MAP_LIBPERL = ",$self->fixpath($libperl),'
  2164. ';
  2165.  
  2166.  
  2167.     push @m,'
  2168. $(MAP_SHRTARGET) : $(MAP_LIBPERL) $(MAP_STATIC) ',"${libperldir}Perlshr_Attr.Opt",'
  2169.     $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_OPTS), $(MAP_EXTRA), $(MAP_LIBPERL) ',"${libperldir}Perlshr_Attr.Opt",'
  2170. $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",'
  2171.     $(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
  2172.     $(NOECHO) $(SAY) "To install the new ""$(MAP_TARGET)"" binary, say"
  2173.     $(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
  2174.     $(NOECHO) $(SAY) "To remove the intermediate files, say
  2175.     $(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
  2176. ';
  2177.     push @m,'
  2178. ',"${tmp}perlmain.c",' : $(MAKEFILE)
  2179.     $(NOECHO) $(PERL) $(MAP_PERLINC) -e "use ExtUtils::Miniperl; writemain(qw|',@staticpkgs,'|)" >$(MMS$TARGET)
  2180. ';
  2181.  
  2182.     push @m, q[
  2183. doc_inst_perl :
  2184.     $(NOECHO) $(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp
  2185.     $(NOECHO) $(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp
  2186.     $(NOECHO) $(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
  2187.     $(NOECHO) $(PERL) -e "print 'MAP_LIBPERL|$(MAP_LIBPERL)|'" >>.MM_tmp
  2188.     $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
  2189.     $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
  2190. ];
  2191.  
  2192.     push @m, "
  2193. inst_perl : pure_inst_perl doc_inst_perl
  2194.     \$(NOECHO) \$(NOOP)
  2195.  
  2196. pure_inst_perl : \$(MAP_TARGET)
  2197.     $self->{CP} \$(MAP_SHRTARGET) ",$self->fixpath($Config{'installbin'},1),"
  2198.     $self->{CP} \$(MAP_TARGET) ",$self->fixpath($Config{'installbin'},1),"
  2199.  
  2200. clean :: map_clean
  2201.     \$(NOECHO) \$(NOOP)
  2202.  
  2203. map_clean :
  2204.     \$(RM_F) ${tmp}perlmain\$(OBJ_EXT) ${tmp}perlmain.c \$(MAKEFILE)
  2205.     \$(RM_F) ${tmp}PerlShr.Opt \$(MAP_TARGET)
  2206. ";
  2207.  
  2208.     join '', @m;
  2209. }
  2210.   
  2211.  
  2212. =item nicetext (override)
  2213.  
  2214. Insure that colons marking targets are preceded by space, in order
  2215. to distinguish the target delimiter from a colon appearing as
  2216. part of a filespec.
  2217.  
  2218. =cut
  2219.  
  2220. sub nicetext {
  2221.  
  2222.     my($self,$text) = @_;
  2223.     $text =~ s/([^\s:])(:+\s)/$1 $2/gs;
  2224.     $text;
  2225. }
  2226.  
  2227. 1;
  2228.  
  2229. =back
  2230.  
  2231. =cut
  2232.  
  2233. __END__
  2234.  
  2235.